home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
ProjectOberon
/
InputPO.mod
< prev
next >
Wrap
Text File
|
1995-07-02
|
3KB
|
112 lines
(*************************************************************************
$RCSfile: InputPO.mod $
Description: Handles keyboard and mouse input for Project Oberon
modules.
Created by: fjc (Frank Copeland)
$Revision: 1.1 $
$Author: fjc $
$Date: 1995/02/07 20:23:27 $
Copyright © 1995, Frank Copeland.
This file is part of Oberon-A.
See Oberon-A.doc for conditions of use and distribution.
NOTE: The module's name is InputPO instead of Input to avoid a name
clash with the Amiga Interface module of the same name.
*************************************************************************)
<* STANDARD- *>
MODULE InputPO;
IMPORT i := Intuition, as := AmigaSupport;
CONST
N = 32;
VAR
mouseKeys : SET;
n, in, out, mouseX, mouseY, mouseW, mouseH : INTEGER;
buf : ARRAY N OF CHAR;
PROCEDURE* KeyProc ( msg : i.IntuiMessagePtr );
BEGIN
IF msg.class = {i.vanillaKey} THEN
IF n < N THEN
buf[in] := CHR (msg.code); in := (in + 1) MOD N; INC (n)
END
END
END KeyProc;
PROCEDURE* MouseProc ( msg : i.IntuiMessagePtr );
BEGIN
IF msg.class = {i.mouseButtons} THEN
IF msg.code = i.selectDown THEN
IF (msg.qualifier * i.altLeft) # {} THEN INCL (mouseKeys, 1)
ELSE INCL (mouseKeys, 2)
END
ELSIF msg.code = i.selectUp THEN
IF (msg.qualifier * i.altLeft) # {} THEN EXCL (mouseKeys, 1)
ELSE EXCL (mouseKeys, 2)
END
ELSIF msg.code = i.middleDown THEN INCL (mouseKeys, 1)
ELSIF msg.code = i.middleUp THEN EXCL (mouseKeys, 1)
ELSIF msg.code = i.menuDown THEN INCL (mouseKeys, 0)
ELSIF msg.code = i.menuUp THEN EXCL (mouseKeys, 0)
END;
mouseX := msg.mouseX - as.win.borderLeft;
mouseY := as.win.height - as.win.borderBottom - msg.mouseY - 1;
END
END MouseProc;
PROCEDURE* TickProc ( msg : i.IntuiMessagePtr );
BEGIN
IF msg.class = {i.intuiTicks} THEN
mouseX := as.win.mouseX - as.win.borderLeft;
mouseY := as.win.height - as.win.borderBottom - as.win.mouseY - 1
END
END TickProc;
PROCEDURE Available* () : INTEGER;
BEGIN
as.GetNextEvent;
RETURN n
END Available;
PROCEDURE Read* ( VAR ch : CHAR );
BEGIN
REPEAT as.GetNextEvent UNTIL n > 0;
DEC (n); ch := buf [out]; out := (out + 1) MOD N
END Read;
PROCEDURE Mouse* ( VAR keys : SET; VAR x, y : INTEGER );
BEGIN
as.GetNextEvent;
IF mouseX < 0 THEN mouseX := 0 END;
IF mouseX >= mouseW THEN mouseX := mouseW - 1 END;
IF mouseY < 0 THEN mouseY := 0 END;
IF mouseY >= mouseH THEN mouseY := mouseH - 1 END;
keys := mouseKeys; x := mouseX; y := mouseY
END Mouse;
PROCEDURE SetMouseLimits* ( w, h : INTEGER );
BEGIN
mouseW := w; mouseH := h
END SetMouseLimits;
PROCEDURE Time* () : LONGINT;
BEGIN RETURN 0
END Time;
BEGIN
n := 0; in := 0; out := 0;
mouseW := as.W; mouseH := as.H;
as.KeyProc := KeyProc;
as.MouseProc := MouseProc;
as.TickProc := TickProc
END InputPO.